home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / p4 / p4-1_2b.lha / p4-1.2b / messages_f / sr_log.f < prev    next >
Text File  |  1993-02-10  |  3KB  |  139 lines

  1.       program systest
  2.  
  3.       include 'p4f.h'
  4.  
  5.       call p4init()
  6.  
  7.       call p4crpg()
  8.       if (p4myid() .eq. 0) then
  9.       call fmaster()
  10.       else
  11.       call fslave()
  12.       endif
  13.       call p4cleanup()
  14.       print *,'mainline exiting normally'
  15.       end
  16.  
  17.  
  18.       subroutine fmaster()
  19.  
  20.       include 'p4f.h'
  21.  
  22.       integer i,slaves,type,from,retcde,recvlen,buflen
  23.       character*40 buffer
  24.       integer TAGCNT, TAGDAT, TAGEND, ALOG_TRUNCATE, SENDING
  25.       parameter (TAGCNT = 10)
  26.       parameter (TAGDAT = 20)
  27.       parameter (TAGEND = 30)
  28.       parameter (ALOG_TRUNCATE = 0)
  29.       parameter (SENDING = 99)
  30.  
  31.       print 11,'Entering fmaster'
  32. 11    format(a)
  33.  
  34.       call alogf1()
  35.       call alogfm(p4myid(),ALOG_TRUNCATE)
  36.       call alogfd(SENDING,"Sending","")
  37.  
  38.       slaves = p4ntotids() - 1
  39.       length = 0
  40.       buflen = 40
  41.  
  42.       do 10 i = 1,slaves
  43.      call alogfl(p4myid(),SENDING,TAGCNT,"")
  44.          call p4sendr(TAGCNT,i,buffer,length,retcde)
  45. 10    continue
  46.  
  47. 20    print *,'Enter a string: '
  48.       read (*,99,end=50) buffer
  49. 99    format(a40)
  50.  
  51.       do 30 length=40,1,-1
  52.          if(buffer(length:length) .ne. ' ') goto 40
  53. 30    continue
  54.       length = 0
  55. 40    continue
  56.  
  57.       call alogfl(p4myid(),SENDING,TAGDAT,"")
  58.       call p4send(TAGDAT,1,buffer,length,retcde)
  59.       buffer = ' '
  60.       type = TAGDAT
  61.       from = -1
  62.       call p4recv(type,from,buffer,buflen,recvlen,retcde)
  63.  
  64.       print *,'MASTER receives from=',from,' buffer=',buffer
  65.       length = 0
  66.       goto 20
  67. 50    continue
  68.  
  69.       do 60 i = 1,slaves
  70.      call alogfl(p4myid(),SENDING,TAGEND,"")
  71.          call p4sendr(TAGEND,i,buffer,buflen,retcde)
  72. 60    continue
  73.  
  74.       call alogfo()
  75.       print *,'Master exiting normally'
  76.       end
  77.  
  78.  
  79.       subroutine fslave()
  80.  
  81.       include 'p4f.h'
  82.  
  83.       character*40 buffer
  84.       integer type, from, next, done, procid, length, buflen
  85.       integer numsl, retcde, recvlen
  86.       integer TAGCNT, TAGDAT, TAGEND, ALOG_TRUNCATE, SENDING
  87.       parameter (TAGCNT = 10)
  88.       parameter (TAGDAT = 20)
  89.       parameter (TAGEND = 30)
  90.       parameter (ALOG_TRUNCATE = 0)
  91.       parameter (SENDING = 99)
  92.  
  93.       numsl = p4ntotids() - 1
  94.       procid = p4myid()
  95.       buflen = 40
  96.  
  97. C     print 200,'slave ',procid,' has started'
  98. C200  format(a,i2,a)
  99. C     call p4flush
  100.  
  101.       if (procid .eq. numsl) then
  102.          next = 0
  103.       else
  104.          next = procid + 1
  105.       endif
  106.  
  107.       call alogfs(p4myid(),ALOG_TRUNCATE)
  108.  
  109. C     print 201,'slave ',procid,' next = ',next
  110. C201  format(a,i2,a,i2)
  111. C     call p4flush
  112.  
  113.       length = 40
  114.       from = -1
  115.       type = TAGCNT
  116.       call p4recv(type,from,buffer,length,recvlen,retcde)
  117.       done = 0
  118.  
  119. 50    if (done .ne. 0) goto 100
  120.  
  121.          buffer = ' '
  122.          length = 40
  123.          from = -1
  124.          type = -1
  125.          call p4recv(type,from,buffer,length,recvlen,retcde)
  126.          if (type .eq. TAGEND) then
  127.             done = 1
  128.          else
  129.         call alogfl(p4myid(),SENDING,TAGDAT,"")
  130.             call p4send(TAGDAT,next,buffer,recvlen,retcde)
  131.          endif
  132.          goto 50
  133.  
  134. 100   continue
  135.  
  136.       call alogfo()
  137.  
  138.       end
  139.